home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 07 - 1991 / 07.12 Dec 91 / Mach 2 Fixes / Multifinder fixings < prev   
Encoding:
Text File  |  1991-09-10  |  27.1 KB  |  1,107 lines  |  [TEXT/QED1]
  1.  
  2. \ ========================================================================
  3. \ ========================================================================
  4. \ ========================================================================
  5. \ I/O Task with Multi-Finder modifications by Murray Anderegg.
  6. \ Potential users should note that this modified I/O Task
  7. \ is NOT official sanctioned by Palo Alto Shipping Company
  8. \ (PASC, the parent company of MACH 2). PASC does believe,
  9. \ however, that this source may be both useful and instructive
  10. \ to other MACH 2 programmers.  We are therefore pleased
  11. \ (and thankful to Mr. Anderegg) to make this source code
  12. \ available "as is" to other users of MACH 2 ("as is" means
  13. \ without support from PASC).
  14.  
  15. \ I/O Task High Level Code
  16. \ Portions (C) Copyright 1987-1988 Palo Alto Shipping Company
  17.  
  18. \ ========================================================================
  19. \ ========================================================================
  20. \ ========================================================================
  21.  
  22. CR .( Loading new I/O task code...) CR
  23.  
  24. ONLY FORTH DEFINITIONS
  25. ALSO MAC
  26. ALSO ASSEMBLER
  27.  
  28. \ ===================== WaitNextEvent definition =========================
  29.  
  30. .TRAP    _WaitNextEvent    $A860
  31.  
  32. CODE WaitNextEvent ( eventMask VAR-eventRecord sleep mouseRgn - flag )
  33.     EXG    D4,A7
  34.     CLR.W    -(A7)            \ This is where we return the result.
  35.     MOVE.W    $E(A6),-(A7)    \ The event mask.
  36.     MOVE.L    $8(A6),-(A7)    \ The event record.
  37.     MOVE.L    $4(A6),-(A7)    \ sleep
  38.     MOVE.L      (A6),-(A7)    \ mouseRgn
  39.     ADDA.W    #$10,A6
  40.     _WaitNextEvent
  41.     MOVE.W    (A7)+,D0        \ flag -> D0
  42.     EXT.L    D0                \ Extend the sign.
  43.     MOVE.L    D0,-(A6)        \ Push it onto the Forth stack.
  44.     EXG    D4,A7
  45.     RTS
  46. END-CODE
  47.  
  48. \ ===== End WaitNextEvent Definition ====================================
  49.  
  50.  
  51. \ ===== Miscellaneous Constants ==========================================
  52. HEX
  53.  
  54. FFFFFF86 CONSTANT screenBits    \ Offset to global Quickdraw variable which
  55.                 \ holds the address of a bitmap record which
  56.                 \ describes the screen currently in use.
  57. 6     CONSTANT screenBounds    \ Offset into a bitmap record to the bounding
  58.                 \ rectangle information.
  59. 08     CONSTANT portBounds    \ Offset to bounding box of screen bitmap.
  60. 00640064 CONSTANT DiskPt
  61. A64     CONSTANT CurActivate    \ Pointer of window to receive activate event.
  62. 1     CONSTANT ActivateMask
  63. 100     CONSTANT CommandKeyMask
  64. FFFFFFFF CONSTANT EveryEvent    \ Recognize every event.
  65.  
  66. 10     CONSTANT portRect    \ Offset to window rect in grafport.
  67. 6C     CONSTANT windowKind    \ Window type field [word].
  68. 8C     CONSTANT controlList    \ Offset to control list in a window record.
  69. 90     CONSTANT nextWindow    \ Next window in Z-ordered list.
  70. 9C     CONSTANT GrowFlagOffset    \ Offset to Mach2 "Does this window
  71.                 \ have a growbox?" flag located past the
  72.                 \ end of a window record.
  73. 9E     CONSTANT VBarOffset    \ A Mach2-generated window with a V- or
  74. A2     CONSTANT HBarOffset    \ H-SCROLLBAR will have either the handle
  75.                 \ to the scrollbar or a 0 at these offsets
  76.                 \ to locations just past the end of a
  77.                 \ window record.
  78. 08     CONSTANT CtrlRectOffset    \ Offset in a Mac control record to
  79.                     \ bounding rectangle for the control.
  80. 60     CONSTANT WNETrap#    \ This is the trap number for WaitNextEvent.
  81. 9F     CONSTANT UnkTrap#    \ This is the trap number for Unimplemented.
  82.  
  83. DECIMAL
  84. 11     CONSTANT PatBic
  85. 129     CONSTANT InThumb
  86.  
  87.  
  88. \ ===== Mach2 Private Global Variables ===================================
  89. HEX
  90.  
  91. : EditHandle (  - a )        \ Address where handle to "Edit" menu
  92.     NP 14 + ;        \ is stored.
  93.  
  94. : EmptyMenuBar ( - a )        \ Address where handle to an empty
  95.     EVENT-RECORD 1E + ;    \ menu is stored.
  96.  
  97. Header MFThere 1 ,
  98.  
  99. \ ===== EVENT-RECORD Offsets =============================================
  100. DECIMAL
  101.  
  102.  0 CONSTANT What
  103.  2 CONSTANT Message
  104.  6 CONSTANT When
  105. 10 CONSTANT Where
  106. 14 CONSTANT Modifiers
  107. 16 CONSTANT WhichWindow
  108.  
  109.  
  110. \ ===== Event Codes ======================================================
  111. DECIMAL
  112.  
  113.  0 CONSTANT Null
  114.  1 CONSTANT MouseDown
  115.  2 CONSTANT MouseUp
  116.  3 CONSTANT KeyDown
  117.  4 CONSTANT KeyUp
  118.  5 CONSTANT AutoKey
  119.  6 CONSTANT UpdateEvent
  120.  7 CONSTANT DiskInserted
  121.  8 CONSTANT ActivateEvent
  122.  
  123.  
  124. \ ===== "FindWindow" result codes ========================================
  125. DECIMAL
  126.  
  127.  0 CONSTANT InDesk
  128.  1 CONSTANT InMenuBar
  129.  2 CONSTANT InSysWindow
  130.  3 CONSTANT InContent
  131.  4 CONSTANT InDrag
  132.  5 CONSTANT InGrow
  133.  6 CONSTANT InGoAway
  134.  7 CONSTANT InZoomIn
  135.  8 CONSTANT InZoomOut
  136.  
  137.  
  138. \ ===== User variable offsets ============================================
  139. DECIMAL
  140.  
  141.  40 CONSTANT HeadOffset
  142.  44 CONSTANT TailOffset
  143.  
  144. 108 CONSTANT TaskMenuBarOffset
  145. 116 CONSTANT MenuDataOffset
  146. 124 CONSTANT ControlDataOffset
  147. 128 CONSTANT ControlHandleOffset
  148. 136 CONSTANT DialogDataOffset
  149. 140 CONSTANT DialogHandleOffset
  150.  
  151. 152 CONSTANT ContentOffset
  152. 156 CONSTANT DragOffset
  153. 160 CONSTANT GrowOffset
  154. 164 CONSTANT GoAwayOffset
  155. 168 CONSTANT UpdateOffset
  156. 172 CONSTANT ActivateOffset
  157. 190 CONSTANT DialogHookOffset
  158. 194 CONSTANT ZoomInOffset
  159. 198 CONSTANT ZoomOutOffset
  160. 202 CONSTANT ControlActionOffset
  161.  
  162. 308    CONSTANT gInBackgroundOffset
  163. 304    CONSTANT SuspendResumeOffset
  164.  
  165.  
  166. \ ===== Start of Code ====================================================
  167. \ ========================================================================
  168. \ ========================================================================
  169.  
  170.  
  171. \ ===== Utility Word =====================================================
  172.  
  173. CODE ScreenRect (  -  rectaddr )
  174.     MOVE.L    (A5),A0
  175.     LEA    screenBits(A0),A0
  176.     LEA    screenBounds(A0),A0
  177.     MOVE.L    A0,-(A6)
  178.     RTS
  179. END-CODE
  180.  
  181. : gInBackground!    { truthValue | homeTask nextTask -- }
  182.     STATUS -> homeTask
  183.     homeTask -> nextTask
  184.     BEGIN
  185.         truthValue nextTask 2+ gInBackgroundOffset + !
  186.         nextTask 2+ @ -> nextTask
  187.     nextTask homeTask =
  188.     UNTIL
  189. ;
  190.  
  191. \ ===== "Non-Vectorable" Default Event Handling Routines =================
  192.  
  193. : Run-Desk (  -  )   ;
  194.  
  195. : Run-System (  -  )
  196.     EVENT-RECORD
  197.     EVENT-RECORD WhichWindow + @
  198.     CALL SystemClick ;
  199.  
  200.  
  201. \ ===== Processing Menu Selections =======================================
  202.  
  203. : Run-Menubar {  | menudata wptr taskptr flag -- }
  204.     EVENT-RECORD Where + @ CALL MenuSelect -> menudata
  205.  
  206.     \ MenuSelect will return zero in the high order word
  207.     \ if no choice is made.
  208.     ^ menudata W@
  209.     IF
  210.         CALL FrontWindow -> wptr
  211.  
  212.         BEGIN
  213.             \ What kind of window is frontmost ?
  214.             \ If it's a system window (a desk accessory window)
  215.             \ look backwards through the linked list of windows
  216.             \ for a window which belongs to a terminal task.
  217.             wptr windowKind + W@ L_EXT 0<
  218.  
  219.             \ Also make sure we haven't reached the end
  220.             \ of the window list.
  221.             wptr 0 <>
  222.             AND
  223.         WHILE
  224.             wptr nextWindow + @ -> wptr
  225.         REPEAT
  226.  
  227.         \ Once we've found a valid window, one with a
  228.         \ window kind greater than zero, we must make
  229.         \ sure it is a terminal window.
  230.         wptr CALL GetWRefCon -> taskptr
  231.         taskptr
  232.         IF
  233.             \ If it is a terminal window we can
  234.             \ send it the menu selection information.
  235.             menudata taskptr MenuDataOffset + !
  236.         THEN
  237.     THEN ;
  238.  
  239. : DoMenuKey {  | menudata wptr taskptr flag -- flag }
  240.     0 -> flag
  241.     EVENT-RECORD Message + 2+ W@ CALL MenuKey -> menudata
  242.     ^ menudata W@
  243.     IF
  244.         CALL FrontWindow -> wptr
  245.         wptr
  246.         IF
  247.             wptr CALL GetWRefCon -> taskptr
  248.             taskptr
  249.             IF
  250.                 taskptr TaskMenuBarOffset + @
  251.                 IF
  252.                     menudata taskptr MenuDataOffset + !
  253.                     -1 -> flag
  254.                 THEN
  255.             THEN
  256.         THEN
  257.     THEN
  258.     flag  ;
  259.  
  260.  
  261. \ ===== Processing Key Input =============================================
  262. HEX
  263.  
  264. : DoKey { | taskptr head tail temp1 temp2 --  }
  265.     CALL FrontWindow
  266.     CALL GetWRefCon -> taskptr
  267.     taskptr
  268.     IF
  269.         taskptr HeadOffset + @    -> head
  270.         taskptr TailOffset + @    -> tail
  271.  
  272.         head 4+ 3F AND        -> temp1   \ Inc the head position
  273.         head FFFFFFC0 AND    -> temp2   \ Get base addr of queue.
  274.         temp1     +> temp2           \ Form new head address.
  275.  
  276.         \ Would the queue overflow if we added a new
  277.         \ character at the new head address ?
  278.         \ (is the queue full?)
  279.         temp2 tail <>
  280.         IF
  281.             \ Store modifiers information in upper
  282.             \ word of local variable.
  283.             EVENT-RECORD Modifiers + W@ ^ temp1 W!
  284.  
  285.             \ Store the key information in the lower
  286.             \ word of local variable.
  287.             EVENT-RECORD Message + 2+ W@ ^ temp1 2+ W!
  288.  
  289.             \ Enqueue the key data.
  290.             temp1 head !
  291.  
  292.             \ Save the new head position.
  293.             temp2 taskptr HeadOffset + !
  294.         ELSE
  295.             5 CALL SysBEEP
  296.         THEN
  297.     ELSE
  298.         5 CALL SysBEEP
  299.     THEN ;
  300. DECIMAL
  301.  
  302. : DoKeyDown (  -  )
  303.     EVENT-RECORD Modifiers + W@ CommandKeyMask AND
  304.     IF
  305.         \ Handle a command key sequence.
  306.         DoMenuKey 0=
  307.         IF
  308.             DoKey
  309.         THEN
  310.     ELSE
  311.         \ Handle key input.
  312.         DoKey
  313.     THEN ;
  314.  
  315.  
  316. \ ===== Processing Disk Events ===========================================
  317.  
  318. : DoDisk (  -  )
  319.     CALL DILoad
  320.     EVENT-RECORD Message + W@
  321.     IF
  322.         DiskPt
  323.         EVENT-RECORD Message + @
  324.         CALL DIBadMount
  325.         DROP
  326.     THEN
  327.     CALL DIUnload ;
  328.  
  329.  
  330. \ ===== "Vectored" Event Handling Routines ===============================
  331. \ ===== (RUN-UPDATE) =====================================================
  332.  
  333. : (RUN-UPDATE) {  | saveport wptr --  }
  334.     EVENT-RECORD Message + @ -> wptr
  335.     ^ saveport CALL GetPort
  336.     wptr       CALL SetPort
  337.  
  338.     wptr CALL BeginUpdate
  339.         wptr GrowFlagOffset + C@
  340.         IF
  341.             wptr VBarOffset + @
  342.             wptr HBarOffset + @ OR
  343.             0=
  344.             IF
  345.                 \ If there is just a growbox, set pen
  346.                 \ to PatBic mode before redrawing the
  347.                 \ grow icon.  This will cause the grow
  348.                 \ box lines to remain invisible.
  349.                 PatBic CALL PenMode
  350.             THEN
  351.             wptr CALL DrawGrowIcon
  352.             CALL PenNormal            
  353.         THEN
  354.         wptr CALL DrawControls
  355.     wptr CALL EndUpdate
  356.     saveport CALL SetPort    ;
  357.  
  358.  
  359. \ ===== (RUN-ACTIVATE) ===================================================
  360.  
  361. : (RUN-ACTIVATE) {  | wptr edith --  }
  362.     EVENT-RECORD Message + @ -> wptr
  363.  
  364.     \ If Mach2 is around this EditHandle will hold
  365.     \ the handle to the Mach2 "Edit" menu.
  366.     EditHandle @         -> edith
  367.  
  368.     \ Check for an activate event.
  369.     EVENT-RECORD Modifiers + W@ ActivateMask AND
  370.     IF
  371.         \ The edit menu should be disabled when the
  372.         \ Mach window becomes the active window.
  373.         edith
  374.         IF
  375.             \ 0 means disable entire menu.
  376.             edith 0 CALL DisableItem
  377.         THEN
  378.     ELSE
  379.         \ Handle deactivate event.
  380.         CurActivate @ windowKind + W@ L_EXT 0<
  381.         IF
  382.             \ A negative value in the windowKind field means
  383.             \ the window is a system window, a desk accessory.
  384.             \ Activate the "Edit" menu.
  385.             edith
  386.             IF
  387.                 \ 0 means enable entire menu.
  388.                 edith 0 CALL EnableItem
  389.             THEN
  390.         THEN
  391.     THEN
  392.     wptr CALL SetPort
  393.     wptr GrowFlagOffset + C@
  394.     IF
  395.         wptr VBarOffset + @
  396.         wptr HBarOffset + @ OR
  397.         0=
  398.         IF
  399.             \ If there is just a growbox, set pen
  400.             \ to PatBic mode before redrawing the
  401.             \ grow icon.  This will cause the grow
  402.             \ box lines to remain invisible.
  403.             PatBic CALL PenMode
  404.         THEN
  405.         wptr CALL DrawGrowIcon
  406.         CALL PenNormal            
  407.     THEN ;
  408.  
  409.  
  410. \ ===== "Vectored" Mouse Down Events =====================================
  411. \ ===== (CHECK-CONTROL) ==================================================
  412.  
  413. : RunUserRoutine { wptr taskptr partcode chandle | address  --  }
  414.     taskptr ControlActionOffset + @ -> address
  415.     address
  416.     IF
  417.         partcode
  418.         chandle
  419.         address EXECUTE
  420.     THEN ;
  421.  
  422. : MachTrackControl { wptr taskptr whichcontrol oldpartcode |
  423.                     point temppartcode  -- flag }
  424.     BEGIN
  425.         CALL StillDown
  426.     WHILE
  427.         ^ point
  428.         CALL GetMouse
  429.  
  430.         whichcontrol
  431.         point
  432.         CALL TestControl -> temppartcode
  433.  
  434.         temppartcode oldpartcode =
  435.         IF
  436.             whichcontrol
  437.             temppartcode
  438.             CALL HiliteControl
  439.  
  440.             wptr taskptr temppartcode whichcontrol
  441.             RunUserRoutine
  442.         ELSE
  443.             whichcontrol
  444.             0
  445.             CALL HiliteControl
  446.         THEN
  447.     REPEAT
  448.     whichcontrol 0 CALL HiliteControl
  449.  
  450.     oldpartcode temppartcode =
  451.     IF
  452.         temppartcode
  453.     ELSE
  454.         0
  455.     THEN ;
  456.  
  457. : MailData { chandle partcode taskptr --  }
  458.     partcode taskptr ControlDataOffset    + W!
  459.     chandle  taskptr ControlHandleOffset    +  !  ;
  460.  
  461. : (CHECK-CONTROL) { wptr | saveport taskptr localpt whichcontrol partcode
  462.                             flag -- flag }
  463.     0 -> flag
  464.     ^ saveport CALL GetPort
  465.     wptr CALL SetPort
  466.     wptr CALL GetWRefCon -> taskptr
  467.     taskptr
  468.     IF
  469.         \ Look in the window record to see if this window
  470.         \ has any controls.
  471.         wptr controlList + @
  472.         IF
  473.             \ If this window has controls (1) convert the
  474.             \ global mouse point coordinate found in the
  475.             \ EVENT-RECORD to a local window mouse
  476.             \ coordinate
  477.             EVENT-RECORD Where + @ -> localpt
  478.             ^ localpt CALL GlobalToLocal
  479.  
  480.             \ and (2) use FindControl to determine
  481.             \ which control in the window experienced
  482.             \ the interaction.
  483.             localpt
  484.             wptr
  485.             ^ whichcontrol
  486.             CALL FindControl -> partcode
  487.  
  488.             \ Check the value of the part code returned.
  489.             \ If the mouse was pressed in an invisible,
  490.             \ inactive, or no control, the part code will
  491.             \ be zero.  If the mouse was pressed in a
  492.             \ visible, active control the part code will
  493.             \ be a valid, non-zero part code value.
  494.             partcode
  495.             IF
  496.                 \ The mouse was clicked in a valid
  497.                 \ control, now follow the mouse to
  498.                 \ see if it was released in the control.
  499.                 -1 -> flag
  500.                 partcode InThumb =
  501.                 IF
  502.                     whichcontrol
  503.                     localpt
  504.                     0
  505.                     CALL TrackControl -> partcode
  506.                 ELSE
  507.                     wptr
  508.                     taskptr
  509.                     whichcontrol
  510.                     partcode
  511.                     MachTrackControl -> partcode
  512.                 THEN
  513.  
  514.                 \ Send the control interaction data
  515.                 \ to the task.
  516.                 whichcontrol partcode taskptr MailData
  517.             THEN
  518.         THEN
  519.     THEN
  520.     saveport CALL SetPort
  521.     flag ;
  522.  
  523.  
  524. \ ===== (RUN-CONTENT) ====================================================
  525.  
  526. : (RUN-CONTENT) {  | wptr taskptr menulist --  }
  527.     \ Is the window clicked in the active window ?
  528.     EVENT-RECORD WhichWindow + @ -> wptr
  529.     CALL FrontWindow  wptr <>
  530.     IF
  531.         \ Initialize local variable.
  532.         EmptyMenuBar @ -> menulist
  533.  
  534.         \ This window was not active, select it.
  535.         wptr CALL SelectWindow
  536.  
  537.         \ If the window just selected has a
  538.         \ menubar, display the menubar.
  539.         \ Otherwise display and empty menubar.
  540.         wptr CALL GetWRefCon -> taskptr
  541.         taskptr
  542.         IF
  543.             \ Check the TaskMenuBar field of the
  544.             \ task's user variable area.  A non-zero
  545.             \ value found there should be the address
  546.             \ where the MenuList handle for the task's
  547.             \ menubar is stored.
  548.             taskptr TaskMenubarOffset + @
  549.             ?DUP
  550.             IF
  551.                 \ Display the task's custom menubar.
  552.                 @ -> menulist
  553.             THEN
  554.         THEN
  555.         menulist CALL SetMenuBar
  556.         CALL DrawMenuBar
  557.     ELSE
  558.         wptr (CHECK-CONTROL) DROP
  559.     THEN ;
  560.  
  561.  
  562. \ ===== (RUN-DRAG) =======================================================
  563.  
  564. : (RUN-DRAG) {  | wptr taskptr --  }
  565.     \ Check to see if the window whose drag region was clicked in
  566.     \ is the current active window
  567.     EVENT-RECORD WhichWindow + @ -> wptr
  568.  
  569.     CALL FrontWindow
  570.     wptr
  571.     <>
  572.     IF
  573.         \ If the window clicked in was not the active window
  574.         \ first check to see if the command key was held down
  575.         \ when the click occurred.  If it was, we will not
  576.         \ activate the window.
  577.         EVENT-RECORD Modifiers +  W@  CommandKeyMask  AND
  578.         0=
  579.         IF
  580.             \ The command key was not down,
  581.             \ select the window.
  582.             wptr CALL SelectWindow
  583.  
  584.             \ If the window just selected has a
  585.             \ menubar, display the menubar.
  586.             \ Otherwise display and empty menubar.
  587.             wptr CALL GetWRefCon -> taskptr
  588.             taskptr
  589.             IF
  590.                 \ Check the TaskMenuBar field of the
  591.                 \ task's user variable area.  A non-zero
  592.                 \ value found there should be the address
  593.                 \ where the MenuList handle for the task's
  594.                 \ menubar is stored.
  595.                 taskptr TaskMenubarOffset + @
  596.                 DUP
  597.                 IF
  598.                     \ Display the task's custom menubar.
  599.                     @ CALL SetMenubar
  600.                 ELSE
  601.                     \ Display an empty menubar.
  602.                     DROP  ( the zero  TaskMenuBar)
  603.                     EmptyMenubar @ CALL SetMenubar
  604.                 THEN
  605.                 CALL DrawMenuBar
  606.             THEN
  607.         THEN
  608.     THEN
  609.     wptr            \ Windowpointer for window to drag.
  610.     EVENT-RECORD Where + @    \ Mouse location in global coordinates.
  611.     ScreenRect        \ Coordinates of this screen.
  612.     CALL DragWindow  ;
  613.  
  614.  
  615. \ ===== (RUN-GROWBOX) ====================================================
  616.  
  617. : RedrawHVBars { wptr | vbarh hbarh -- }
  618.     wptr VBarOffset + @ -> vbarh
  619.     wptr HBarOffset + @ -> hbarh
  620.  
  621.     vbarh
  622.     IF
  623.         \ Hide the control before we redraw it.
  624.         vbarh CALL HideControl
  625.  
  626.         \ Move the control to its new position.
  627.         vbarh
  628.         wptr portRect + 6 + W@ 15 -    \ Horizontal destination.
  629.         wptr portRect + W@ 1-        \ Vertical destination.
  630.         CALL MoveControl
  631.  
  632.         \ Resize the control
  633.         vbarh
  634.         16                \ New control width.
  635.         wptr portRect + 4+ W@ 13 -    \ New control height.
  636.         CALL SizeControl
  637.  
  638.         \ Now tell the window manager that the control
  639.         \ area has already been redrawn
  640.         vbarh @ ctrlRectOffset +
  641.         CALL ValidRect
  642.  
  643.         \ Now the control can be made visible again.
  644.         vbarh CALL ShowControl
  645.     THEN
  646.  
  647.     hbarh
  648.     IF
  649.         hbarh CALL HideControl
  650.  
  651.         hbarh
  652.         wptr portRect + 2+ W@ 1-    \ Horiz. dest.
  653.         wptr portRect + 4+ W@ 15 -    \ Vert. dest.
  654.         CALL MoveControl
  655.  
  656.         hbarh
  657.         wptr portRect + 6 + W@ 13 -    \ New width.
  658.         16                \ New height.
  659.         CALL SizeControl
  660.  
  661.         hbarh @ ctrlRectOffset +
  662.         CALL ValidRect
  663.  
  664.         hbarh CALL ShowControl
  665.     THEN ;
  666.  
  667. : EraseEdges { wptr | oldbot oldright rightbot lefttop --  }
  668.     ^ lefttop ^ rightbot 2DROP
  669.     wptr portRect + 4+ W@ -> oldbot
  670.     wptr portRect + 6 + w@ -> oldright
  671.  
  672.     \ First, erase bottom edge of window.
  673.     oldbot 16 -    ^ lefttop    W!    \ Top of rect to be erased.
  674.     0        ^ lefttop 2+    W!    \ Left of rect to be erased.
  675.     oldbot        ^ rightbot    W!    \ Bot. of rect to be erased.
  676.     oldright    ^ rightbot 2+    W!    \ Right of rect to be erased.
  677.     ^ lefttop CALL EraseRect
  678.     ^ lefttop CALL InvalRect
  679.  
  680.     \ Next, erase right edge of window.
  681.     0        ^ lefttop    W!
  682.     oldright 16 -    ^ lefttop 2+    W!
  683.     oldbot        ^ rightbot    W!
  684.     oldright    ^ rightbot 2+    W!
  685.     ^ lefttop CALL EraseRect
  686.     ^ lefttop CALL InvalRect  ;
  687.  
  688. : (RUN-GROWBOX) {  | wptr wrect oldheight
  689.             rightbot lefttop newwidth newheight --  }
  690.     EVENT-RECORD WhichWindow + @ -> wptr
  691.     CALL FrontWindow  wptr  =
  692.     IF
  693.         wptr portRect +            -> wrect
  694.         wrect 4+ W@    wrect W@ -    -> oldheight
  695.         ScreenRect ^ lefttop 8 CMOVE
  696.  
  697.         wptr CALL SetPort
  698.         wptr
  699.         EVENT-RECORD Where + @
  700.         ^ lefttop
  701.         CALL GrowWindow     -> newwidth
  702.         ^ newwidth W@    -> newheight
  703.         0 ^ newwidth W!
  704.  
  705.         \ Is the window shorter ?
  706.         newheight oldheight <
  707.         IF
  708.             wrect CALL InvalRect
  709.             wrect CALL EraseRect
  710.         THEN
  711.  
  712.         wptr EraseEdges
  713.         wptr newwidth newheight -1 CALL SizeWindow
  714.         wptr EraseEdges
  715.  
  716.         wptr RedrawHVBars
  717.     THEN ;
  718.  
  719.  
  720. \ ===== (RUN-CLOSEBOX) ===================================================
  721.  
  722. : (RUN-CLOSEBOX) {  | wptr menuhandle taskptr --  }
  723.     \ If the window is not the active window, leave.
  724.     EVENT-RECORD WhichWindow + @ -> wptr
  725.     CALL FrontWindow  wptr =
  726.     IF
  727.         \ Initialize the contents of the menulist local variable.
  728.         EmptyMenubar @ -> menuhandle
  729.  
  730.         \ Follow the mouse.
  731.         \ If it is not released inside of the close box, leave.
  732.         wptr
  733.         EVENT-RECORD Where + @
  734.         CALL TrackGoAway
  735.         IF
  736.             \ Hide the window and get the window
  737.             \ pointer for the window immediately behind
  738.             \ the window just closed, if any.
  739.             wptr CALL HideWindow
  740.             CALL FrontWindow -> wptr
  741.             wptr
  742.             IF
  743.                 \ If the window just uncovered has a
  744.                 \ menubar, display the menubar.
  745.                 \ Otherwise display and empty menubar.
  746.                 wptr CALL GetWRefCon -> taskptr
  747.                 taskptr
  748.                 IF
  749.                     \ Check the TaskMenuBar field of
  750.                     \ the task's user variable area.
  751.                     \ A non-zero value found there
  752.                     \ should be the address where the
  753.                     \ MenuList handle for the task's
  754.                     \ menubar is stored.
  755.                     taskptr TaskMenubarOffset + @
  756.                     ?DUP
  757.                     IF
  758.                         \ Display the task's
  759.                         \ custom menubar.
  760.                         @ -> menuhandle
  761.                     THEN
  762.                 THEN
  763.             THEN
  764.             menuhandle CALL SetMenuBar
  765.             CALL DrawMenubar
  766.         THEN
  767.     THEN  ;
  768.  
  769.  
  770. \ ===== (RUN-ZOOMIN) =====================================================
  771. \ ===== (RUN-ZOOMOUT) ====================================================
  772.  
  773. : DoZoom { findcode | wptr taskptr  --  }
  774.     EVENT-RECORD WhichWindow + @ -> wptr
  775.     CALL FrontWindow wptr =
  776.     IF
  777.         wptr CALL SetPort
  778.  
  779.         wptr
  780.         EVENT-RECORD Where + @
  781.         findcode
  782.         CALL TrackBox
  783.         IF
  784.             wptr EraseEdges
  785.  
  786.             wptr findcode -1 CALL ZoomWindow
  787.  
  788.             wptr EraseEdges
  789.             wptr RedrawHVBars
  790.         THEN
  791.     THEN ;
  792.  
  793. : (RUN-ZOOMIN) (  -  )
  794.     InZoomIn DoZoom ;
  795.  
  796. : (RUN-ZOOMOUT) (  -  )
  797.     InZoomOut DoZoom ;
  798.  
  799.  
  800. \ ===== MouseDown Event Dispatch Routine =================================
  801.  
  802. : DoMouseDown {  | findcode window taskptr  -- }
  803.     EVENT-RECORD Where + @
  804.     ^ window
  805.     CALL FindWindow -> findcode
  806.  
  807.     \ If click is in the menubar, we must specifically check for
  808.     \ the frontwindow.
  809.     findcode InMenuBar =
  810.     IF
  811.         CALL FrontWindow -> window
  812.     THEN
  813.  
  814.     \ If click is in the growbox area, make sure the window has a
  815.     \ growbox.  If it doesn't, turn click into an in-content code.
  816.     findcode InGrow =
  817.     IF
  818.         window GrowFlagOffset + C@ 0=
  819.         IF
  820.             InContent -> findcode
  821.         THEN
  822.     THEN
  823.  
  824.     \ We will only process this event if we have a valid windowpointer.
  825.     window
  826.     IF
  827.         window EVENT-RECORD WhichWindow + !
  828.         window CALL GetWRefCon -> taskptr
  829.         taskptr
  830.         IF
  831.             findcode
  832.             CASE
  833.                 InContent     OF taskptr ContentOffset +
  834.                            @ EXECUTE    ENDOF
  835.                 InDrag        OF taskptr DragOffset +
  836.                            @ EXECUTE    ENDOF
  837.                 InGrow        OF taskptr GrowOffset +
  838.                            @ EXECUTE    ENDOF
  839.                 InGoAway    OF taskptr GoAwayOffset +
  840.                            @ EXECUTE    ENDOF
  841.                 InZoomIn    OF taskptr ZoomInOffset +
  842.                            @ EXECUTE    ENDOF
  843.                 InZoomOut    OF taskptr ZoomOutOffset +
  844.                            @ EXECUTE    ENDOF
  845.  
  846.                 InSysWindow    OF Run-System    ENDOF
  847.                 InMenuBar    OF Run-Menubar    ENDOF
  848.                 InDesk        OF Run-Desk    ENDOF
  849.             ENDCASE
  850.         ELSE
  851.             findcode
  852.             CASE
  853.                 InContent     OF (RUN-CONTENT)    ENDOF
  854.                 InDrag        OF (RUN-DRAG)        ENDOF
  855.                 InGrow        OF (RUN-GROWBOX)    ENDOF
  856.                 InGoAway    OF (RUN-CLOSEBOX)    ENDOF
  857.                 InZoomIn    OF (RUN-ZOOMIN)        ENDOF
  858.                 InZoomOut    OF (RUN-ZOOMOUT)    ENDOF
  859.  
  860.                 InSysWindow    OF Run-System    ENDOF
  861.                 InMenuBar    OF Run-Menubar    ENDOF
  862.                 InDesk        OF Run-Desk    ENDOF
  863.             ENDCASE
  864.         THEN
  865.     THEN  ;
  866.  
  867.  
  868. \ ===== Modeless Dialog Event Dispatch Routine ===========================
  869. \ ===== (HandleDialog) ===================================================
  870.  
  871. : (HandleDialog) {  | thedialog itemhit wptr taskptr --  }
  872. \ This routine is called if a modeless dialog event has occurred.
  873. \ We know it is a modeless dialog event because a modal dialog
  874. \ would use its own event loop.
  875.     \ If the event involves an enabled dialog item, DialogSelect
  876.     \ will return TRUE and will return the dialog handle and
  877.     \ the item number affected in the specified local variables.
  878.     EVENT-RECORD   ^ thedialog   ^ itemhit  CALL DialogSelect
  879.     IF
  880.         \ Which terminal task is using this modeless dialog ?
  881.         CALL FrontWindow -> wptr
  882.         wptr
  883.         IF
  884.             wptr CALL GetWRefCon -> taskptr
  885.             taskptr
  886.             IF
  887.                 \ If we were able to find the taskptr
  888.                 \ we can place the important information
  889.                 \ about the modeless dialog interaction
  890.                 \ in the appropriate user variable fields
  891.                 \ of the task's user variable area.
  892.  
  893.                 \ The item number is a word length value.
  894.                 \ It will be returned in the upper 2 bytes
  895.                 \ of the local variable.
  896.                 ^ itemhit W@
  897.                 taskptr DialogDataOffset +
  898.                 W!
  899.  
  900.                 thedialog
  901.                 taskptr DialogHandleOffset +
  902.                 !
  903.             THEN
  904.         THEN
  905.     THEN ;
  906.  
  907.  
  908. \ ===== Event Dispatching Routines =======================================
  909.  
  910. : HandleDialog  {  | taskptr wptr eventWhat  --  }
  911. \ If it's a dialog event (and not an activate or update), the Message field of
  912. \ the EVENT-RECORD will not contain a window pointer, we must
  913. \ specifically ask for the window pointer.
  914.     EVENT-RECORD What +  W@  -> eventWhat
  915.     eventWhat ActivateEvent =   eventWhat UpdateEvent =  OR
  916.     IF
  917.         EVENT-RECORD Message +  @  -> wptr
  918.     ELSE
  919.         CALL FrontWindow  -> wptr
  920.     THEN
  921.     wptr
  922.     IF
  923.         wptr CALL GetWRefCon  -> taskptr
  924.         taskptr
  925.         IF
  926.             taskptr DialogHookOffset +  @ EXECUTE
  927.         ELSE
  928.             (HandleDialog)
  929.         THEN
  930.     THEN ;
  931.  
  932. : DoUpdate {  | taskptr --  }
  933.     EVENT-RECORD Message + @ CALL GetWRefCon -> taskptr
  934.     taskptr
  935.     IF
  936.         taskptr UpdateOffset + @ EXECUTE
  937.     ELSE
  938.         (RUN-UPDATE)
  939.     THEN  ;
  940.  
  941. : DoActivate {  | taskptr --  }
  942.     EVENT-RECORD Message + @ CALL GetWRefCon -> taskptr
  943.     taskptr
  944.     IF
  945.         taskptr ActivateOffset + @ EXECUTE
  946.     ELSE
  947.         (RUN-ACTIVATE)
  948.     THEN  ;
  949.  
  950. : (RUN-SUSPEND/RESUME)    { | wptr -- }
  951.     CALL FrontWindow -> wptr
  952.     EVENT-RECORD Message + @ EVENT-RECORD Modifiers + W!
  953.     wptr EVENT-RECORD Message + !
  954.     (RUN-ACTIVATE)
  955. ;
  956.  
  957. : DoSuspendResume    { | wptr taskptr -- }
  958.     EVENT-RECORD Message + @ activateMask AND
  959.     IF
  960.         FALSE gInBackground!        \ signal tasks to resume 
  961.         CALL FrontWindow -> wptr
  962.         wptr 0= NOT
  963.         IF ( you have a front window )
  964.             wptr windowKind + W@ L_EXT 0<
  965.             IF ( this is a desk accessory )
  966.                 EVENT-RECORD Modifiers + W@        \ post an activate event
  967.                 activateMask OR EVENT-RECORD Modifiers + W!
  968.                 EVENT-RECORD CALL SystemEvent DROP
  969.             ELSE
  970.                 wptr CALL GetWRefCon ?DUP
  971.                 IF
  972.                     wptr CALL SetPort
  973.                     SuspendResumeOffset + @ EXECUTE
  974.                 THEN
  975.             THEN
  976.         THEN
  977.     ELSE
  978.         TRUE gInBackground!        \ signal tasks to suspend
  979.         CALL FrontWindow -> wptr
  980.         wptr 0= NOT
  981.         IF ( you have a front window )
  982.             wptr windowKind + W@ L_EXT 0<
  983.             IF ( this is a desk accessory )
  984.                 EVENT-RECORD Modifiers + W@        \ post a deactivate event
  985.                 $FFFE AND EVENT-RECORD Modifiers + W!
  986.                 EVENT-RECORD CALL SystemEvent DROP
  987.             ELSE
  988.                 wptr CALL GetWRefCon ?DUP
  989.                 IF
  990.                     wptr CALL SetPort
  991.                     SuspendResumeOffset + @ EXECUTE
  992.                 THEN
  993.             THEN
  994.         THEN
  995.     THEN
  996. ;
  997.  
  998. : NextEvent (  -  )  ;
  999.  
  1000.  
  1001. \ ===== (EVENT-TABLE =====================================================
  1002.  
  1003. CREATE (EVENT-TABLE)
  1004.     DC.L    NextEvent-"(EVENT-TABLE)"-4    \ (0)    Null event.
  1005.     DC.L    "DoMouseDown"-"(EVENT-TABLE)"-4    \ (1)    Mouse down event.
  1006.     DC.L    NextEvent-"(EVENT-TABLE)"-4    \ (2)    Mouse up event.
  1007.     DC.L    "DoKeyDown"-"(EVENT-TABLE)"-4    \ (3)    Key down event.
  1008.     DC.L    NextEvent-"(EVENT-TABLE)"-4    \ (4)    Key up event.
  1009.     DC.L    "DoKeyDown"-"(EVENT-TABLE)"-4    \ (5)    Auto key event.
  1010.     DC.L    "DoUpdate"-"(EVENT-TABLE)"-4    \ (6)    Update event.
  1011.     DC.L    "DoDisk"-"(EVENT-TABLE)"-4    \ (7)    Disk event.
  1012.     DC.L    "DoActivate"-"(EVENT-TABLE)"-4    \ (8)    Activate event.
  1013.     DC.L    NextEvent-"(EVENT-TABLE)"-4    \ (9)    Not used ?
  1014.     DC.L    NextEvent-"(EVENT-TABLE)"-4    \ (10)    Network event.
  1015.     DC.L    NextEvent-"(EVENT-TABLE)"-4    \ (11)    Driver event.
  1016.     DC.L    NextEvent-"(EVENT-TABLE)"-4    \ (12)    Appl-defined event #1.
  1017.     DC.L    NextEvent-"(EVENT-TABLE)"-4    \ (13)    Appl-defined event #2.
  1018.     DC.L    NextEvent-"(EVENT-TABLE)"-4    \ (14)    Appl-defined event #3.
  1019.     DC.L    "DoSuspendResume"-"(EVENT-TABLE)"-4    \ (15)    osEvent.
  1020.  
  1021. : HandleEvent {  | eventcode baseaddr --  }
  1022.     EVENT-RECORD What + W@    -> eventcode
  1023.     (EVENT-TABLE)        -> baseaddr
  1024.     baseaddr        \ Base address.
  1025.     eventcode 4*        \ Index into event table.
  1026.     + @            \ Offset to routine.
  1027.     baseaddr +        \ Address of routine.
  1028.     EXECUTE  ;
  1029.  
  1030.  
  1031. \ ===== The Main Loop ====================================================
  1032.  
  1033. : DialogEvent? (  -  f  )
  1034.     \ If the event is a dialog event which should be handled
  1035.     \ by our application (usually by being passed to DialogSelect),
  1036.     \ IsDialogEvent will return a true flag.  If the event
  1037.     \ should be handled as a normal, non-dialog event, false
  1038.     \ will be returned.
  1039.     EVENT-RECORD CALL IsDialogEvent ;
  1040.  
  1041. : GetNextEvent (  - f )
  1042.     \ If an event occurs which should be handled, GetNextEvent
  1043.     \ will return a true flag.  The event code and any other
  1044.     \ event information will be returned in the EVENT-RECORD.
  1045.     \ Changed for MF support using Jorg's code 22 XI 88 - M. Anderegg
  1046.     ['] MFThere @
  1047.     CASE
  1048.     -1    OF    \ Yes, we have WaitNextEvent.
  1049.         everyEvent EVENT-RECORD 1 0 WaitNextEvent
  1050.         ENDOF
  1051.     0    OF    \ No, we don't have WaitNextEvent.
  1052.         CALL SystemTask
  1053.         everyEvent EVENT-RECORD CALL GetNextEvent
  1054.         ENDOF
  1055.     ENDCASE
  1056. ;
  1057.  
  1058. : WNECheck    ( - )
  1059.     \ This routine is executed the first time through the I/O Task
  1060.     \ main loop.  It leaves the truth value for the presence of the
  1061.     \ WaitNextEvent Trap at MFThere.  This modification is necessary,
  1062.     \ since Jorg's modification worked at compile time instead of run time.
  1063.     \ - M. Anderegg - 6 I 89.
  1064.  
  1065.     WNETrap#    CALL GetTrapAddress
  1066.     UnkTrap#    CALL GetTrapAddress
  1067.     =
  1068.     IF
  1069.         0
  1070.     ELSE
  1071.         -1
  1072.     THEN
  1073.     ['] MFThere !
  1074. ;
  1075.  
  1076. \ ===== (IOTASK) =========================================================
  1077.  
  1078. : (IOTask) {  | dialogflag eventflag --  }
  1079.     WNECheck
  1080.     0 gInBackground!
  1081.     BEGIN
  1082.             BEGIN
  1083.                 GetNextEvent    -> eventflag
  1084.                 DialogEvent?    -> dialogflag
  1085.  
  1086.                 dialogflag
  1087.                 IF
  1088.                     HandleDialog
  1089.                 ELSE
  1090.                     eventflag
  1091.                     IF
  1092.                         HandleEvent
  1093.                     THEN
  1094.                 THEN
  1095.             eventflag 0=
  1096.             UNTIL
  1097.         PAUSE
  1098.     AGAIN ;
  1099.  
  1100. ONLY FORTH
  1101.  
  1102. NEW-IOTASK
  1103.  
  1104. \ ===== END OF FILE ======================================================
  1105. \ ========================================================================
  1106. \ ========================================================================
  1107.